home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
pbc22b.zip
/
PBC$BAS.ZIP
/
FILESORT.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-01-01
|
2KB
|
61 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
TYPE FileName
Arf AS STRING * 12 ' because TYPE is still pretty brain-dead
END TYPE
TYPE Partition
Lft AS INTEGER
Rht AS INTEGER
END TYPE
SUB FileSort (Array() AS FileName, Elements%)
DIM x AS STRING * 12
DIM SortStack(1 TO 16) AS Partition
S% = 1
SortStack(1).Lft = 1
SortStack(1).Rht = Elements%
DO
L% = SortStack(S%).Lft
R% = SortStack(S%).Rht
S% = S% - 1
DO
i% = L%
j% = R%
x = Array((L% + R%) \ 2).Arf
DO
WHILE Array(i%).Arf < x
i% = i% + 1
WEND
WHILE x < Array(j%).Arf
j% = j% - 1
WEND
IF i% <= j% THEN
SWAP Array(i%), Array(j%)
i% = i% + 1
j% = j% - 1
END IF
LOOP UNTIL i% > j%
IF j% - L% < R% - i% THEN
IF i% < R% THEN
S% = S% + 1
SortStack(S%).Lft = i%
SortStack(S%).Rht = R%
END IF
R% = j%
ELSE
IF L% < j% THEN
S% = S% + 1
SortStack(S%).Lft = L%
SortStack(S%).Rht = j%
END IF
L% = i%
END IF
LOOP UNTIL L% >= R%
LOOP WHILE S%
END SUB